home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ftpser1a / ftp_srv2.bas < prev    next >
BASIC Source File  |  1999-10-04  |  20KB  |  560 lines
  1. Attribute VB_Name = "FTP_Srv2"
  2. Option Explicit
  3.  
  4. Sub ServerLog(ByVal Str As String)
  5.   FtpServ.LogWnd.AddItem Str
  6.   FtpServ.LogWnd.Selected(FtpServ.LogWnd.ListCount - 1) = True
  7. End Sub
  8.  
  9. 'EXEC A FTP COMMAND:
  10. '<id_user> is a number in the range 1 to MAX_N_USERS
  11. 'identifing the user who sends the command;
  12. '<cmd> is the command.
  13.  
  14. Function exec_FTP_cmd(Id_User As Integer, cmd As String) As Integer
  15. Dim Kwrd As String 'keyword
  16. Dim Argument(5) As String 'arguments
  17. Dim ArgN As Long
  18. Dim FTP_Err As Integer 'error
  19. Dim PathName As String, Drv As String
  20.  
  21. Dim Full_Name As String 'pathname & file name
  22. Dim File_Len As Long 'file lenght in bytes
  23. Dim i As Long
  24.  
  25. Dim Ok As Integer
  26. Dim Buffer As String
  27. Dim DummyS As String
  28.  
  29.  
  30. 'variables used during the data exchange
  31. Dim ExecSlot As Integer
  32. Dim NewSockAddr As SockAddr, LclSockAddr As SockAddr
  33.  
  34. On Error Resume Next 'routine for error interception
  35.  
  36. FTP_Err = sintax_ctrl(cmd, Kwrd, Argument())
  37. 'log commands
  38. ServerLog "<" & Format$(Id_User, "000") & "> " & Format$(Date$, "dd/mm/yy ") & Format$(Time$, "hh:mm - ") & cmd
  39. If FTP_Err <> 0 Then
  40.   retf = send_reply(sintax_error_list(FTP_Err), Id_User)
  41.   Exit Function
  42. End If
  43.  
  44. Select Case UCase$(Kwrd)
  45.   Case "USER":  'USER <username>
  46.   Ok = False
  47.   Debug.Print N_RECOGNIZED_USERS;
  48.   For i = 1 To N_RECOGNIZED_USERS
  49.     'Debug.Print UserIDs.No(i).Name
  50.     'controls if the user is in the list of known users
  51.     If Argument(0) = UserIDs.No(i).Name Then
  52.       'the user must enter a password but anonymous users can be accepted
  53.       If UserIDs.No(i).Name = "anonymous" Then
  54.         retf = send_reply("331 User anonymous accepted, please type your e-mail address as password.", Id_User)
  55.       Else
  56.         retf = send_reply("331 User name Ok, type in your password.", Id_User)
  57.       End If
  58.       users(Id_User).list_index = i
  59.       users(Id_User).cur_dir = UserIDs.No(i).Home
  60.       users(Id_User).state = 1
  61.       Ok = True
  62.       Exit For
  63.     End If
  64.   Next
  65.   If Not Ok Then  'unknown user
  66.     retf = send_reply("530 Not logged in, user " & Argument(0) & " is unknown.", Id_User)
  67.     retf = logoff(Id_User)
  68.   End If
  69.  
  70.   Case "PASS": 'PASS <password>
  71.   If users(Id_User).state = 1 Then
  72.     If LCase(UserIDs.No(users(Id_User).list_index).Name) = "anonymous" Then
  73.       'anonymous user
  74.       retf = send_reply("230 User anonymous logged in, proceed.", Id_User)
  75.       users(Id_User).state = 2
  76.     Else
  77.       If Argument(0) = UserIDs.No(users(Id_User).list_index).Pass Then
  78.         'correct password, the user can proceed
  79.         retf = send_reply("230 User logged in, proceed.", Id_User)
  80.         users(Id_User).state = 2
  81.       Else
  82.         'wrong password, the user is disconnected
  83.         retf = send_reply("530 Not logged in, wrong password.", Id_User)
  84.         retf = logoff(Id_User)
  85.       End If
  86.     End If
  87.   Else
  88.     'the user must enter his name
  89.     retf = send_reply("503 I need your username.", Id_User)
  90.   End If
  91.   
  92.   Case "CWD", "XCWD": 'CWD <pathname>
  93.   If users(Id_User).state = 2 Then
  94.     PathName = ChkPath(Id_User, Argument(0))
  95.     Drv = Left(PathName, 2)
  96.     ChDrive Drv
  97.     ChDir PathName
  98.     If Err.Number = 0 Then
  99.       users(Id_User).cur_dir = CurDir
  100.       'existing directory
  101.       retf = send_reply("250 CWD command executed.", Id_User)
  102.     ElseIf (Err.Number > 51 And Err.Number < 77) Or (Err.Number > 707 And Err.Number < 732) Then
  103.       'no existing directory
  104.       retf = send_reply("550 CWD command not executed: " & Error$, Id_User)
  105.     Else
  106.       'FtpServ.StatusBar.panels(1) = "Error " & CStr(Err) & " occurred."
  107.       retf = logoff(Id_User)
  108.       'End
  109.     End If
  110.   Else
  111.     'user not logged in
  112.     retf = send_reply("530 User not logged in.", Id_User)
  113.   End If
  114.  
  115.   Case "CDUP", "XCUP": 'CDUP
  116.   If users(Id_User).state = 2 Then
  117.     ChDir users(Id_User).cur_dir
  118.     ChDir ".."
  119.     users(Id_User).cur_dir = CurDir
  120.     retf = send_reply("200 CDUP command executed.", Id_User)
  121.   Else
  122.     retf = send_reply("530 User not logged in.", Id_User)
  123.   End If
  124.  
  125.   Case "QUIT": 'QUIT
  126.   retf = logoff(Id_User)
  127.  
  128.   Case "PORT": 'PORT <host-port>
  129.   If users(Id_User).state = 2 Then
  130.     'opens a data connection
  131.     ExecSlot = Socket(PF_INET, SOCK_STREAM, IPPROTO_TCP)
  132.     If ExecSlot < 0 Then
  133.       'error
  134.       retf = send_reply("425 Can't build data connection.", Id_User)
  135.     Else
  136.       NewSockAddr.sin_family = PF_INET
  137.       'remote IP address
  138.       IPLong.Byte4 = Val(Argument(0))
  139.       IPLong.Byte3 = Val(Argument(1))
  140.       IPLong.Byte2 = Val(Argument(2))
  141.       IPLong.Byte1 = Val(Argument(3))
  142.       CopyMemory i, IPLong, 4
  143.       NewSockAddr.sin_addr = i
  144.       
  145.       'remote port
  146.       ArgN = Val(Argument(4))
  147.       NewSockAddr.sin_port = htons(ArgN)
  148.       retf = connect(ExecSlot, NewSockAddr, 16)
  149.       If retf < 0 Then
  150.         retf = send_reply("425 Can't build data connection.", Id_User)
  151.       Else
  152.         retf = send_reply("200 PORT command executed.", Id_User)
  153.         'stores the IP-address and port number in user record
  154.         users(Id_User).data_slot = ExecSlot
  155.         users(Id_User).IP_address = Argument(0) & "." & Argument(1) & "." & Argument(2) & "." & Argument(3)
  156.         users(Id_User).Port = Val(Argument(4))
  157.         ServerLog ("IP=" & users(Id_User).IP_address & ":" & Argument(4))
  158.         '<state> field establishes that now is
  159.         'possible to exec commands requiring a data connection
  160.         users(Id_User).state = 3
  161.       End If
  162.     End If
  163.   Else
  164.     retf = send_reply("530 User not logged in.", Id_User)
  165.   End If
  166.  
  167.   Case "TYPE": 'TYPE <type-code>
  168.   If users(Id_User).state = 2 Then
  169.     'stores the access parameters in user record
  170.     retf = send_reply("200 TYPE command executed.", Id_User)
  171.     users(Id_User).data_representation = Argument(0)
  172.     users(Id_User).data_format_ctrls = Argument(1)
  173.   Else
  174.     retf = send_reply("530 User not logged in.", Id_User)
  175.   End If
  176.  
  177.   Case "STRU": 'STRU <structure-code>
  178.   If users(Id_User).state = 2 Then
  179.     'stores access parameters in the user record
  180.     retf = send_reply("200 STRU command executed.", Id_User)
  181.     users(Id_User).data_structure = Argument(0)
  182.   Else
  183.     retf = send_reply("530 User not logged in.", Id_User)
  184.   End If
  185.   
  186.   Case "MODE": 'MODE <mode-code>
  187.   If users(Id_User).state = 2 Then
  188.     'stores access parameters in the user record
  189.     retf = send_reply("200 MODE command executed.", Id_User)
  190.     users(Id_User).data_tx_mode = Argument(0)
  191.   Else
  192.     retf = send_reply("530 User not logged in.", Id_User)
  193.   End If
  194.  
  195.   Case "RETR": 'RETR <pathname>
  196.   If users(Id_User).state = 3 Then
  197.     Full_Name = ChkPath(Id_User, Argument(0))
  198.     'file exist?
  199.     i = FileLen(Full_Name)
  200.     If Err.Number = 0 Then 'Yes
  201.       'controls access rights
  202.       DummyS = UserIDs.No(users(Id_User).list_index).Priv(1).Accs
  203.       If InStr(DummyS, "R") Then
  204.         retf = open_data_connect(Id_User)
  205.         'initializes record which contains file parameters
  206.         files_info(Id_User).Full_Name = Full_Name
  207.         files_info(Id_User).data_representation = users(Id_User).data_representation
  208.         files_info(Id_User).open_file = False
  209.         files_info(Id_User).retr_stor = 0
  210.         'enables timer to send data on connection
  211.         FtpServ.Timer1(Id_User).Enabled = True
  212.       Else
  213.         'the user can't retrieves files
  214.         retf = send_reply("550 You can't take this file action.", Id_User)
  215.         retf = close_data_connect(Id_User)
  216.       End If
  217.     ElseIf (Err.Number > 51 And Err.Number < 77) Or (Err.Number > 707 And Err.Number < 732) Then
  218.       'no existing file
  219.       retf = send_reply("550 RETR command not executed: " & Error$, Id_User)
  220.       retf = close_data_connect(Id_User)
  221.     Else
  222.       FtpServ.StatusBar.Panels(1) = "Error " & Err.Number & " occurred."
  223.       retf = close_data_connect(Id_User)
  224.       retf = logoff(Id_User)
  225.       'End
  226.     End If
  227.   ElseIf users(Id_User).state = 2 Then
  228.     retf = send_reply("425 Can't open data connection.", Id_User)
  229.   Else
  230.     retf = send_reply("530 User not logged in.", Id_User)
  231.   End If
  232.  
  233.   Case "STOR": 'STOR <pathname>
  234.   If users(Id_Us